home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / csfilesc / filetool.ctl < prev    next >
Text File  |  1998-10-01  |  14KB  |  424 lines
  1. VERSION 5.00
  2. Begin VB.UserControl FileTool 
  3.    CanGetFocus     =   0   'False
  4.    ClientHeight    =   330
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   360
  8.    InvisibleAtRuntime=   -1  'True
  9.    Picture         =   "FileTool.ctx":0000
  10.    ScaleHeight     =   330
  11.    ScaleWidth      =   360
  12.    ToolboxBitmap   =   "FileTool.ctx":018A
  13. End
  14. Attribute VB_Name = "FileTool"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = True
  19. Option Explicit
  20.  
  21. Private Declare Function BinSearchPath Lib "kernel32" Alias "SearchPathA" (ByVal lpPath As String, ByVal lpFileName As String, ByVal lpExtension As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
  22. Private Declare Function GetBinaryType Lib "kernel32" Alias "GetBinaryTypeA" (ByVal lpApplicationName As String, lpBinaryType As Long) As Long
  23. Private Declare Function apiGetVersion Lib "kernel32" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
  24. Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
  25.  
  26. Private Type SHITEMID 'mkid
  27.     cb As Long
  28.     abID As Byte
  29. End Type
  30.  
  31. Private Type ITEMIDLIST 'idl
  32.     mkid As SHITEMID
  33. End Type
  34.  
  35. Private Type BROWSEINFO 'bi
  36.     hOwner As Long
  37.     pidlRoot As Long
  38.     pszDisplayName As String
  39.     lpszTitle As String
  40.     ulFlags As Long
  41.     lpfn As Long
  42.     lParam As Long
  43.     iImage As Long
  44. End Type
  45.         
  46. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
  47.     (ByVal pidl As Long, ByVal pszPath As String) As Long
  48.  
  49. Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
  50.     (lpBrowseInfo As BROWSEINFO) As Long
  51.  
  52. Private Type OPENFILENAME
  53.     lStructSize As Long
  54.     hwndOwner As Long
  55.     hInstance As Long
  56.     lpstrFilter As String
  57.     lpstrCustomFilter As String
  58.     nMaxCustFilter As Long
  59.     nFilterIndex As Long
  60.     lpstrFile As String
  61.     nMaxFile As Long
  62.     lpstrFileTitle As String
  63.     nMaxFileTitle As Long
  64.     lpstrInitialDir As String
  65.     lpstrTitle As String
  66.     Flags As Long
  67.     nFileOffset As Integer
  68.     nFileExtension As Integer
  69.     lpstrDefExt As String
  70.     lCustData As Long
  71.     lpfnHook As Long
  72.     lpTemplateName As String
  73. End Type
  74.  
  75. Private Type OSVERSIONINFO
  76.         dwOSVersionInfoSize As Long
  77.         dwMajorVersion As Long
  78.         dwMinorVersion As Long
  79.         dwBuildNumber As Long
  80.         dwPlatformId As Long
  81.         szCSDVersion As String * 128
  82. End Type
  83.  
  84. Private Const BIF_RETURNONLYFSDIRS = &H1
  85.  
  86. Private Const SCS_32BIT_BINARY = 0
  87. Private Const SCS_DOS_BINARY = 1
  88. Private Const SCS_WOW_BINARY = 2
  89. Private Const SCS_PIF_BINARY = 3
  90. Private Const SCS_POSIX_BINARY = 4
  91. Private Const SCS_OS216_BINARY = 5
  92.  
  93. Public Enum CSBinaryTypes
  94.     NonExecutable
  95.     BinaryWin_32Bit
  96.     BinaryDos
  97.     BinaryOS2_16Bit
  98.     BinaryPIF
  99.     BinaryPosix
  100.     BinaryWin_16Bit
  101. End Enum
  102.  
  103. 'Default Property Values:
  104. Const m_def_SearchPath = ""
  105. Const m_def_File = ""
  106. Const m_def_FilterIndex = 1
  107. Const m_def_Filters = "All Files (*.*)|*.*"
  108. 'Property Variables:
  109. Dim m_SearchPath As String
  110. Dim m_File As String
  111. Dim m_Filters As String
  112. Dim m_FilterIndex As Long
  113.  
  114. Public Property Get FilterIndex() As Long
  115. Attribute FilterIndex.VB_Description = "Returns or sets a default filter for SelectFile or SelectSave dialog box."
  116. Attribute FilterIndex.VB_HelpID = 2019
  117.     On Error Resume Next
  118.     FilterIndex = m_FilterIndex
  119. End Property
  120. Public Property Let FilterIndex(ByVal newIndex As Long)
  121.     On Error Resume Next
  122.     m_FilterIndex = Abs(newIndex)
  123.     PropertyChanged "FilterIndex"
  124. End Property
  125. Public Property Get Filters() As String
  126. Attribute Filters.VB_Description = "Returns or sets the filters that are displayed in the Type list box of a SelectFile or SelectSave dialog box."
  127. Attribute Filters.VB_HelpID = 2018
  128.     On Error Resume Next
  129.     Filters = m_Filters
  130. End Property
  131. Public Property Let Filters(ByVal newFilters As String)
  132.     On Error Resume Next
  133.     m_Filters = newFilters
  134.     PropertyChanged "Filters"
  135. End Property
  136. Private Property Get FileFilters() As String
  137.     Dim sFilters As String
  138.     sFilters = m_Filters & Chr$(0)
  139.     While (InStr(1, sFilters, "|") > 0)
  140.         Mid(sFilters, InStr(1, sFilters, "|"), 1) = Chr(0)
  141.     Wend
  142.     FileFilters = sFilters
  143. End Property
  144.  
  145.  
  146. Public Property Get SearchPath() As String
  147. Attribute SearchPath.VB_Description = "Sets the path or paths to search."
  148. Attribute SearchPath.VB_HelpID = 2011
  149.     On Error Resume Next
  150.     If Trim(m_SearchPath) = "" Then
  151.         SearchPath = Environ("PATH")
  152.     Else
  153.         SearchPath = m_SearchPath
  154.     End If
  155. End Property
  156.  
  157. Public Property Let SearchPath(ByVal New_SearchPath As String)
  158.     On Error Resume Next
  159.     m_SearchPath = New_SearchPath
  160.     PropertyChanged "SearchPath"
  161. End Property
  162.  
  163. Public Property Get File() As String
  164. Attribute File.VB_Description = "The name of the file to search for."
  165. Attribute File.VB_HelpID = 2004
  166.     On Error Resume Next
  167.     File = m_File
  168. End Property
  169.  
  170. Public Property Let File(ByVal New_File As String)
  171.     On Error Resume Next
  172.     m_File = New_File
  173.     PropertyChanged "File"
  174. End Property
  175. Private Property Get FilePart() As String
  176.     On Error Resume Next
  177.     If InStr(File, ".") > 0 Then
  178.         FilePart = Left(File, InStr(File, ".") - 1)
  179.     End If
  180. End Property
  181. Private Property Get ExtPart() As String
  182.     On Error Resume Next
  183.     ExtPart = Right(File, Len(File) - Len(FilePart))
  184. End Property
  185. Public Function Search() As String
  186. Attribute Search.VB_Description = "Used to find the location of a file specified in the File Property.  "
  187. Attribute Search.VB_HelpID = 3002
  188.     On Error Resume Next
  189.     Dim tmpBuf As String, l As Long
  190.     If Trim(File) = "" Then
  191.         Search = ""
  192.         Exit Function
  193.     End If
  194.     tmpBuf = Space(1025)
  195.     BinSearchPath SearchPath, FilePart, ExtPart, 1024, tmpBuf, l
  196.     tmpBuf = Left(tmpBuf, InStr(tmpBuf, vbNullChar))
  197.     Search = tmpBuf
  198. End Function
  199. Public Property Get PathExists(ByVal SeachPath As String) As Boolean
  200. Attribute PathExists.VB_Description = "Used to determine if a path exists on the users system."
  201. Attribute PathExists.VB_HelpID = 2017
  202.     On Error Resume Next
  203.     Dim l As Long
  204.     If Trim(SearchPath) = "" Then
  205.         PathExists = False
  206.         Exit Property
  207.     End If
  208.     l = GetAttr(Trim(SearchPath))
  209.     PathExists = (l = 16 And Err = 0)
  210. End Property
  211. Public Property Get Exists(ByVal SearchFile As String) As Boolean
  212. Attribute Exists.VB_Description = "A read only property to determine if a file exists on the users system."
  213. Attribute Exists.VB_HelpID = 2002
  214.     On Error Resume Next
  215.     Dim l As Long
  216.     If Trim(SearchFile) = "" Then
  217.         Exists = False
  218.         Exit Property
  219.     End If
  220.     l = GetAttr(Trim(SearchFile))
  221.     Exists = (l <> 16 And Err = 0)
  222. End Property
  223. Private Property Get isNT() As Boolean
  224.     On Error Resume Next
  225.     Dim OSystem As OSVERSIONINFO
  226.     OSystem.dwOSVersionInfoSize = 148
  227.     apiGetVersion OSystem
  228.     isNT = (OSystem.dwPlatformId = 2)
  229. End Property
  230. Public Property Get IsBinary(ByVal CheckFile As String) As Boolean
  231. Attribute IsBinary.VB_Description = "A read only property to determine if a file is Binary. (NT only)"
  232. Attribute IsBinary.VB_HelpID = 2007
  233.     On Error Resume Next
  234.     If Not isNT Then
  235.         On Error GoTo 0
  236.         Err.Raise 40004, Ambient.DisplayName, "IsBinary Property is only available under Windows NT"
  237.         IsBinary = False
  238.         Exit Property
  239.     End If
  240.     IsBinary = Not (BinaryType(CheckFile) = NonExecutable)
  241. End Property
  242.  
  243. Public Property Get BinaryType(ByVal CheckFile As String) As CSBinaryTypes
  244. Attribute BinaryType.VB_Description = "A read only property to determine if a file is an executable and the type of executable."
  245. Attribute BinaryType.VB_HelpID = 2001
  246.     
  247.     On Error Resume Next
  248.     If Not isNT Then
  249.         On Error GoTo 0
  250.         Err.Raise 40004, Ambient.DisplayName, "Binary